home *** CD-ROM | disk | FTP | other *** search
/ Amiga Plus 2000 #5 / Amiga Plus CD - 2000 - No. 5.iso / Tools / Dev / fpc / inc / objinc.inc < prev    next >
Encoding:
Text File  |  1998-10-28  |  10.2 KB  |  306 lines
  1. {
  2.     $Id: objinc.inc,v 1.3 1998/07/13 12:31:40 carl Exp $
  3.     This file is part of the Free Pascal run time library.
  4.     Copyright (c) 1993-98 by the Free Pascal development team.
  5.  
  6.     Includefile for objects.pp implementing OS-dependent file routines
  7.     for AmigaOS
  8.  
  9.     See the file COPYING.FPC, included in this distribution,
  10.     for details about the copyright.
  11.  
  12.     This program is distributed in the hope that it will be useful,
  13.     but WITHOUT ANY WARRANTY; without even the implied warranty of
  14.     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
  15.  
  16.  **********************************************************************
  17. }
  18.  
  19.     Const
  20.  
  21.     _LVOFindTask          = -294;
  22.     _LVOWaitPort          = -384;
  23.     _LVOGetMsg            = -372;
  24.     _LVOOpenLibrary       = -552;
  25.     _LVOCloseLibrary      = -414;
  26.     _LVOClose             = -36;
  27.     _LVOOpen              = -30;
  28.     _LVOIoErr             = -132;
  29.     _LVOSeek              = -66;
  30.     _LVODeleteFile        = -72;
  31.     _LVORename            = -78;
  32.     _LVOWrite             = -48;
  33.     _LVORead              = -42;
  34.     _LVOCreateDir         = -120;
  35.     _LVOSetCurrentDirName = -558;
  36.     _LVOGetCurrentDirName = -564;
  37.     _LVOInput             = -54;
  38.     _LVOOutput            = -60;
  39.     _LVOUnLock            = -90;
  40.     _LVOLock              = -84;
  41.     _LVOCurrentDir        = -126;
  42.  
  43.     _LVONameFromLock      = -402;
  44.     _LVONameFromFH        = -408;
  45.     _LVOGetProgramName    = -576;
  46.     _LVOGetProgramDir     = -600;
  47.     _LVODupLock           =  -96;
  48.     _LVOExamine           = -102;
  49.     _LVOParentDir         = -210;
  50.     _LVOSetFileSize       = -456;
  51.  
  52.  
  53.  
  54.  
  55. {---------------------------------------------------------------------------}
  56. {  FileClose -> Platforms AmigaOS          - Not checked                    }
  57. {---------------------------------------------------------------------------}
  58. FUNCTION FileClose(Handle: THandle): word;
  59. begin
  60.   asm
  61.             move.l  handle,d1
  62.             move.l  a6,d6              { save a6 }
  63.             move.l  _DOSBase,a6
  64.             jsr     _LVOClose(a6)
  65.             move.l  d6,a6              { restore a6 }
  66.   end;
  67.    FileClose := 0;
  68. end;
  69.  
  70. {---------------------------------------------------------------------------}
  71. {  FileOpen -> Platforms AmigaOS          - 08Jul98 CEC                     }
  72. {  Returns 0 on failure                                                     }
  73. {---------------------------------------------------------------------------}
  74.  
  75. FUNCTION FileOpen (Var FileName: AsciiZ; Mode: Word): THandle;
  76. var
  77.  oflags : longint;
  78.  AHandle : THandle;
  79. begin
  80.   AHandle:=0;
  81.   { On opening reset error code }
  82.   DosStreamError := 0;
  83.   if Mode=stCreate then
  84.       { read/write file with creation of file }
  85.       oflags := 1006
  86.   else
  87.       { read/write access on existing file }
  88.       oflags := 1005;
  89.       asm
  90.              move.l  a6,d6                  { save a6 }
  91.  
  92.              move.l  FileName,d1
  93.              move.l  oflags,d2               { MODE_READWRITE }
  94.              move.l  _DOSBase,a6
  95.              jsr     _LVOOpen(a6)
  96.              tst.l   d0
  97.              bne     @noopenerror           { on zero an error occured }
  98.              jsr     _LVOIoErr(a6)
  99.              move.w  d0,DosStreamError
  100.              bra     @openend
  101.           @noopenerror:
  102.              move.l  d6,a6                 { restore a6 }
  103.              move.l  d0,AHandle            { we need the base pointer to access this variable }
  104.              bra     @end
  105.           @openend:
  106.              move.l  d6,a6                 { restore a6 }
  107.           @end:
  108.          end;
  109.    FileOpen := AHandle;
  110. end;
  111.  
  112.  
  113. {***************************************************************************}
  114. {  DosSetFilePtr -> Platforms AmigaOS      - 08Jul98 CEC                    }
  115. {***************************************************************************}
  116. FUNCTION SetFilePos (Handle: THandle; Pos: LongInt; MoveType: Word;
  117. Var Actual: LongInt): Word;
  118. Var
  119.   Move_typ : longint;
  120. BEGIN
  121.   Move_typ := 0;
  122.   { Move from beginning of file }
  123.   if MoveType = 0 then
  124.    Move_typ := -1;
  125.   { Move from current position of file }
  126.   If MoveType = 1 then
  127.    Move_typ := 0;
  128.   { Move from end of file              }
  129.   If MoveType = 2 then
  130.     Move_typ := 1;
  131.        { We have to seek TWO times, if we wish to get the actual absolute }
  132.        { file position normally.                                          }
  133.        asm
  134.              move.l  a6,d6                { Save base pointer            }
  135.  
  136.              move.l  handle,d1
  137.              move.l  d2,-(sp)
  138.              move.l  d3,-(sp)              { save registers              }
  139.  
  140.              move.l  pos,d2
  141.              move.l  Move_typ,d3           { Setup correct move type     }
  142.              move.l  _DOSBase,a6
  143.              jsr    _LVOSeek(a6)
  144.  
  145.              move.l  (sp)+,d3              { restore registers }
  146.              move.l  (sp)+,d2
  147.              cmp.l   #-1,d0                { is there a file access error? }
  148.              bne     @noerr_one            { no, then seek a second time   }
  149.              jsr     _LVOIoErr(a6)         { yes ,get error in d0 and jmp  }
  150.              bra     @err
  151.       @noerr_one:                          { Seek a second time            }
  152.              move.l  d6,a6                 { Restore base pointer          }
  153.  
  154.              move.l  handle,d1
  155.              move.l  d2,-(sp)
  156.              move.l  d3,-(sp)              { save registers                }
  157.  
  158.              move.l  pos,d2
  159.              move.l  Move_typ,d3           { Setup correct move type     }
  160.              move.l  _DOSBase,a6
  161.              jsr    _LVOSeek(a6)
  162.  
  163.              move.l  (sp)+,d3              { restore registers }
  164.              move.l  (sp)+,d2
  165.              cmp.l   #-1,d0                { is there a file access error? }
  166.              bne     @noerr
  167.              jsr     _LVOIoErr(a6)
  168.       @err:
  169.              move.w  d0,DosStreamError
  170.              move.l  d6,a6                 { restore a6 }
  171.              bra     @seekend
  172.       @noerr:
  173.              move.l  d6,a6                 { restore a6 }
  174.              move.l  Actual,a0             { Get address of variable }
  175.              move.l  d0,(a0)               { Set value of Actual     }
  176.       @seekend:
  177.        end;
  178.    SetFilePos := DosStreamError;                   { Return any error }
  179. END;
  180.  
  181.  
  182. {---------------------------------------------------------------------------}
  183. {  FileRead -> Platforms AmigaOS          - 08Jul98 CEC                     }
  184. {---------------------------------------------------------------------------}
  185. FUNCTION FileRead (Handle: THandle; Var Buf; Count: Sw_Word;
  186. Var Actual: Sw_Word): Word;
  187. BEGIN
  188.   if Count <= 0 then
  189.   Begin
  190.      FileRead:=1;  { Return a non zero error }
  191.      exit;
  192.   end;
  193.   asm
  194.             move.l  a6,d6
  195.  
  196.             movem.l d2/d3,-(sp)
  197.             move.l  handle,d1         { we must set up aparamters BEFORE }
  198.             move.l  buf,d2            { setting up a6 for the OS call    }
  199.             move.l  count,d3
  200.             move.l  _DOSBase,a6
  201.             jsr     _LVORead(a6)
  202.             movem.l (sp)+,d2/d3
  203.  
  204.             cmp.l   #-1,d0
  205.             bne     @doswrend              { if -1 = error }
  206.             jsr     _LVOIoErr(a6)
  207.             move.w  d0,DosStreamError
  208.             bra     @doswrend2
  209.           @doswrend:
  210.             { to store a result for the function  }
  211.             { we must of course first get back the}
  212.             { base pointer!                       }
  213.             move.l  d6,a6
  214.             move.l  Actual,a0   { Actual is a pointer! }
  215.             move.l  d0,(a0)
  216.             bra     @end
  217.           @doswrend2:
  218.             move.l  d6,a6
  219.           @end:
  220.   end;
  221.   FileRead:=DosStreamError;
  222. end;
  223.  
  224.  
  225. {---------------------------------------------------------------------------}
  226. {  FileWrite -> Platforms AmigAOS          - 08Jul98 CEC                    }
  227. {---------------------------------------------------------------------------}
  228. FUNCTION FileWrite (Handle: THandle; Var Buf; Count: Sw_Word; Var Actual: Sw_Word): Word;
  229. BEGIN
  230.   if Count <= 0 then
  231.    Begin
  232.     FileWrite:=1;  { Return a non zero error code }
  233.     exit;
  234.    end;
  235.   asm
  236.             move.l  a6,d6
  237.  
  238.             movem.l d2/d3,-(sp)
  239.             move.l  handle,d1             { we must of course set up the }
  240.             move.l  buf,d2                { parameters BEFORE getting    }
  241.             move.l  count,d3              { _DOSBase                     }
  242.             move.l  _DOSBase,a6
  243.             jsr     _LVOWrite(a6)
  244.             movem.l (sp)+,d2/d3
  245.  
  246.             cmp.l   #-1,d0
  247.             bne     @doswrend              { if -1 = error }
  248.             jsr     _LVOIoErr(a6)
  249.             move.w  d0,DosStreamError
  250.             bra     @doswrend2
  251.           @doswrend:
  252.             { we must restore the base pointer before setting the result }
  253.             move.l  d6,a6
  254.             move.l  Actual,a0   { Actual is a pointer! }
  255.             move.l  d0,(a0)
  256.             bra     @end
  257.           @doswrend2:
  258.             move.l  d6,a6
  259.           @end:
  260.   end;
  261.    Actual:=Count;
  262.    FileWrite:=DosStreamError;
  263. end;
  264.  
  265.  
  266. {---------------------------------------------------------------------------}
  267. {  SetFileSize -> Platforms AmigaOS      - 08Jul98 CEC                      }
  268. {---------------------------------------------------------------------------}
  269. FUNCTION SetFileSize (Handle: THandle; FileSize: LongInt): Word;
  270. BEGIN
  271.       { Point to the end of the file }
  272.       { with the new size            }
  273.       asm
  274.       @noerr_one:                          { Seek a second time            }
  275.              move.l  a6,d6                 { Save base pointer             }
  276.  
  277.              move.l  handle,d1
  278.              move.l  d2,-(sp)
  279.              move.l  d3,-(sp)              { save registers                }
  280.  
  281.              move.l  FileSize,d2
  282.              move.l  #-1,d3                { Setup correct move type     }
  283.              move.l  _DOSBase,a6           { from beginning of file      }
  284.              jsr    _LVOSetFileSize(a6)
  285.  
  286.              move.l  (sp)+,d3              { restore registers }
  287.              move.l  (sp)+,d2
  288.              cmp.l   #-1,d0                { is there a file access error? }
  289.              bne     @noerr
  290.              jsr     _LVOIoErr(a6)
  291.              move.w  d0,DosStreamError
  292.       @noerr:
  293.              move.l  d6,a6                 { restore a6 }
  294.       end;
  295.       SetFileSize:=DosStreamError;
  296. END;
  297.  
  298. {
  299.   $Log: objinc.inc,v $
  300.   Revision 1.3  1998/07/13 12:31:40  carl
  301.     * bugfix of FileOpen, on error would not return zero
  302.  
  303.  
  304. }
  305.  
  306.